home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / smix130.zip / MIXTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1997-06-06  |  7KB  |  250 lines
  1. {       SMIX is Copyright 1995 by Ethan Brodsky.  All rights reserved.       }
  2. program MixTest;
  3.   uses
  4.     CRT,
  5.     Detect,
  6.     SMix;
  7.   const
  8.     XMSRequired   = 200;    {XMS memory required to load the sounds (KBytes) }
  9.     SharedEMB     = true;
  10.       {TRUE:   All sounds will be stored in a shared EMB}
  11.       {FALSE:  Each sound will be stored in a separate EMB}
  12.     NumSounds = 6;
  13.   var
  14.     BaseIO: word; IRQ, DMA, DMA16: byte;
  15.     Sound: array[0..NumSounds-1] of PSound;
  16.     OldExitProc: pointer;
  17.  
  18.   function HexW(W: word): string; {Word}
  19.     const
  20.       HexChars: array [0..$F] of Char = '0123456789ABCDEF';
  21.     begin
  22.       HexW :=
  23. {        HexChars[(W and $F000) shr 12] +}
  24.         HexChars[(W and $0F00) shr 8]  +
  25.         HexChars[(W and $00F0) shr 4]  +
  26.         HexChars[(W and $000F)];
  27.     end;
  28.  
  29.   procedure OurExitProc; far;
  30.    {If the program terminates with a runtime error before the extended memory}
  31.    {is deallocated, then the memory will still be allocated, and will be lost}
  32.    {until the next reboot.  This exit procedure is ALWAYS called upon program}
  33.    {termination and will deallocate extended memory if necessary.            }
  34.     var
  35.       i: byte;
  36.     begin
  37.       for i := 0 to NumSounds-1 do
  38.         if Sound[i] <> nil then FreeSound(Sound[i]);
  39.       if SharedEMB then ShutdownSharing;
  40.       ExitProc := OldExitProc; {Chain to next exit procedure}
  41.     end;
  42.  
  43.   procedure LoadSounds;
  44.     var
  45.       i: integer;
  46.     begin
  47.       if not(InitXMS)
  48.         then
  49.           begin
  50.             writeln('Error initializing extended memory');
  51.             writeln('HIMEM.SYS must be installed');
  52.             Halt(3); {XMS driver not installed}
  53.           end
  54.         else
  55.           begin
  56.             writeln('Extended memory succesfully initialized');
  57.             write('Free XMS memory:  ', GetFreeXMS, 'k  ');
  58.             if GetFreeXMS < XMSRequired
  59.               then
  60.                 begin
  61.                   writeln('Insufficient free XMS');
  62.                   writeln('You are probably running MIXTEST from the protected mode IDE');
  63.                   writeln('Run it from the command line or read the documentation');
  64.                   Halt(4); {Insufficient XMS memory}
  65.                 end
  66.               else
  67.                 begin
  68.                   writeln('Loading sounds');
  69.                   if SharedEMB then InitSharing;
  70.  
  71.                   if not(OpenSoundResourceFile('MIXTEST.SND'))
  72.                     then
  73.                       begin
  74.                         writeln('Error loading sound resource file');
  75.                         Halt(5); {Sound resource file does not exist}
  76.                       end;
  77.  
  78.  
  79.                   LoadSound(Sound[0], 'JET');
  80.                   LoadSound(Sound[0], 'SINE');
  81.                   LoadSound(Sound[1], 'GUN');
  82.                   LoadSound(Sound[2], 'CRASH');
  83.                   LoadSound(Sound[3], 'CANNON');
  84.                   LoadSound(Sound[4], 'LASER');
  85.                   LoadSound(Sound[5], 'GLASS');
  86.  
  87.                   CloseSoundResourceFile;
  88.  
  89.                   OldExitProc := ExitProc;
  90.                   ExitProc := @OurExitProc;
  91.                 end
  92.           end;
  93.     end;
  94.  
  95.   procedure FreeSounds;
  96.     var
  97.       i: integer;
  98.     begin
  99.       for i := 0 to NumSounds-1 do
  100.         FreeSound(Sound[i]);
  101.       if SharedEMB then ShutdownSharing;
  102.     end;
  103.  
  104.   procedure Init;
  105.     begin
  106.       writeln;
  107.       writeln('-------------------------------------------');
  108.       writeln('Sound Mixing Library v1.30 by Ethan Brodsky');
  109.       if not(GetSettings(BaseIO, IRQ, DMA, DMA16))
  110.         then
  111.           begin
  112.             writeln('Error initializing:  Invalid or non-existant BLASTER environment variable');
  113.             Halt(1); {BLASTER environment variable invalid or non-existant}
  114.           end;
  115.  
  116.       if not(InitSB(BaseIO, IRQ, DMA, DMA16))
  117.         then
  118.           begin
  119.             writeln('Error initializing sound card');
  120.             writeln('Incorrect base IO address, sound card not installed, or broken');
  121.             Halt(2); {Sound card could not be initialized}
  122.           end;
  123.  
  124.       writeln('BaseIO=', HexW(BaseIO), 'h     IRQ', IRQ, '     DMA8=', DMA, '     DMA16=', DMA16);
  125.       write('DSP version ', DSPVersion shr 8, '.', DSPVersion and $FF, ':  ');
  126.  
  127.       if SixteenBit
  128.         then write('16-bit, ')
  129.         else write('8-bit, ');
  130.       if AutoInit
  131.         then writeln('Auto-initialized')
  132.         else writeln('Single-cycle');
  133.  
  134.       InitMixing;
  135.       writeln;
  136.     end;
  137.  
  138.   procedure Shutdown;
  139.     begin
  140.       ShutdownMixing;
  141.       ShutdownSB;
  142.  
  143.       writeln;
  144.     end;
  145.  
  146.   var
  147.     Counter: LongInt;
  148.     InKey: char;
  149.     Stop: boolean;
  150.     Num: byte;
  151.     Temp: integer;
  152.     Jet: boolean;
  153.     RandSounds: boolean;
  154.     Rate: word;
  155.   begin
  156.     Randomize;
  157.  
  158.     Init;
  159.  
  160.     LoadSounds;
  161.  
  162.     writeln('Press:');
  163.     writeln(' J  Toggle jet engine');
  164.     writeln(' R  Toggle random sounds');
  165.     writeln(' 1  Machine Gun');
  166.     writeln(' 2  Crash');
  167.     writeln(' 3  Cannon');
  168.     writeln(' 4  Laser');
  169.     writeln(' 5  Breaking glass');
  170.     writeln(' <  Reduce sampling rate');
  171.     writeln(' >  Increase sampling rate');
  172.     writeln(' Q  Quit');
  173.  
  174.     Stop := false;
  175.     Counter := 0;
  176.     Jet        := false;
  177.     RandSounds := true;
  178.     Rate       := 22000;
  179.  
  180.     repeat
  181.      {Display counters}
  182.       Inc(Counter);
  183.       write(Counter:8, IntCount:8, VoiceCount:4, Rate:8);
  184.       GotoXY(1, WhereY);
  185.  
  186.  
  187.      {Maybe start a random sound}
  188.       if RandSounds and (Random(64000) = 0)
  189.         then
  190.           begin
  191.             Num := Random(NumSounds-1)+1;
  192.             StartSound(Sound[Num], Num, false);
  193.           end;
  194.  
  195.      {Start a sound if a key is pressed}
  196.       if KeyPressed
  197.         then
  198.           begin
  199.             InKey := ReadKey;
  200.               case InKey
  201.                 of
  202.                   'J', 'j':
  203.                     begin
  204.                       Jet := not(Jet);
  205.                       If Jet
  206.                         then StartSound(Sound[0], 0, true)
  207.                         else StopSound(0);
  208.                     end;
  209.  
  210.                   'R', 'r':
  211.                     RandSounds := not(RandSounds);
  212.  
  213.                   '0'..'9':
  214.                     begin
  215.                       Val(InKey, Num, Temp);
  216.                       if Num < NumSounds
  217.                         then
  218.                           StartSound(Sound[Num], Num, false);
  219.                     end;
  220.  
  221.                   '<', ',':
  222.                     begin
  223.                       Rate := Rate - 250;
  224.                       if (Rate < 5000) then Rate := 5000;
  225.                       SetSamplingRate(Rate);
  226.                     end;
  227.  
  228.                   '>', '.':
  229.                     begin
  230.                       Rate := Rate + 250;
  231.                       if (Rate > 48000) then Rate := 48000;
  232.                       SetSamplingRate(Rate);
  233.                     end;
  234.  
  235.                   else
  236.                     Stop := true;
  237.                 end;
  238.           end;
  239.     until Stop;
  240.  
  241.     writeln;
  242.  
  243.     if Jet then
  244.       StopSound(0);
  245.  
  246.     Shutdown;
  247.  
  248.     FreeSounds;
  249.   end.
  250.